perm filename CLUST.SAI[11,ALS]2 blob
sn#063644 filedate 1973-09-26 generic text, type T, neo UTF8
00010 BEGIN "CLUSTER"
00020 DEFINE ⊂="COMMENT"; ⊂ 10/7/73;
00030 ⊂ This program has been simplified for use in getting
00040 histographs;
00050
00060 DEFINE NU="'250000000000";
00070 REQUIRE "BLOCKS.HDR[4,ALS]" SOURCE_FILE;
00080 EXTERNAL STRING PROCEDURE INCHWL;
00090 DEFINE BUFSIZ="1024",CNTSIZ="100";
00100 STRING TFILEI,FILEI,OPT1,MESS,SPONAM;
00110 INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
00120 INTEGER ARRAY LFILE[0:'177];
00130 INTEGER CHAN1,CHAN4,CHAN6,EOF,IEOF,FILEC,CHAN2;
00140 INTEGER BPT,SEGCNT,SEGTOT,H,I,J,K,L,Q,ZZ;
00150 INTERNAL INTEGER M,N,P,RATE,FLAG,SEGC,INTOT,HINT,TFLAG,UPCNT;
00160 LABEL STRT,LABELA,LABELB,ZZZZ,FINISH;
00170 INTEGER ARRAY COUNT[0:63,0:63];
00180 PRELOAD_WITH '1000000000,'1000000,'1000,1;
00190 INTEGER ARRAY BIT[0:3];
00200 INTEGER ARRAY GVAL,GFLAG[0:3];
00210 INTEGER ARRAY IX[0:1];
00220 STRING ARRAY IN,GATENA[0:3];
00230 INTEGER M1,M2,M3,M4,N1,N2,N3,N4,POINTL;
00240 INTEGER ARRAY SUMM,SUMN[0:63,0:3];
00250 INTEGER ARRAY MTOT,NTOT[0:3];
00260 INTEGER BIN,TOT,TOTD;
00270 INTEGER HINCNT,HCOUNT,HINDEX,PREHINT;
00280
00290 PRELOAD_WITH
00300 '777777,
00310 '777000777,
00320 '777777000,
00330 '777000000777,
00340 '777000777000,
00350 '777777000000,
00360 '777,
00370 '777000,
00380 '777000000,
00390 '777000000000,
00400 0;
00410 INTEGER ARRAY MASK[0:10];
00420
00430 PRELOAD_WITH
00440 '21,'22,'23,'24,'25,'26,'41,'42,'43,'44,6;
00450 INTEGER ARRAY SYMBOL[0:10];
00460
00470 DEFINE FF="'14",CRLF0="CR&'177&'21";
00480
00490 INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
00500 BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
00510 BOOLEAN NF;
00520 LOOKUP(CHAN,FILENAME,NF);
00530 WHILE NF DO
00540 BEGIN
00550 OUTSTR(CR&LF&"Can't find "&FILENAME&". try [1,VIN], File=");
00560 FILENAME ← INCHWL ;
00570 LOOKUP(CHAN,FILENAME,NF)
00580 END;
00590 END "LOOKIN";
00600
00610 INTEGER PROCEDURE HEADER;
00620 BEGIN "HEADER"
00630 INTEGER I,J,K,H1;
00640 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; HINCNT←HINCNT+1;
00650 RETURN(PREHINT) END ELSE WHILE HCOUNT=0 DO BEGIN "XX"
00660 I←LFILE[HINDEX]; K←LDB(POINT(14,I,27)); J←SEGC-K;
00670 IF I=0 THEN BEGIN PREHINT←NU; HCOUNT←999; RETURN(PREHINT) END;
00680 IF J ≥ 0 THEN BEGIN "LATCH"
00690 H1←I LAND '777760000000;
00700
00710 IF H1≠0 THEN BEGIN
00720 PREHINT←H1; HCOUNT←LDB(POINT(8,I,35));
00730 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; HINCNT←HINCNT+1;
00740 RETURN(PREHINT); DONE END
00750 ELSE BEGIN PREHINT←NU; HCOUNT←LDB(POINT(8,I,35));
00760 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE; END;
00770 END "LATCH";
00780 PREHINT←NU; RETURN(PREHINT); END "XX";
00790 END "HEADER";
00800
00810
00820 PROCEDURE TOP;
00830 BEGIN
00840 SETFORMAT(2,0); OUT(CHAN2,CRLF&TB&" ");
00850 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
00860 IF (J MOD 10)=0 THEN OUT(CHAN2,CVS(J)[1 TO 1]) ELSE
00870 OUT(CHAN2," "); IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
00880 OUT(CHAN2,CRLF&"IN1\IN2"&TB&" ");
00890 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
00900 OUT(CHAN2,CVS(J)[2 TO 2]); IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
00910 OUT(CHAN2,CRLF&TB&"+");
00920 FOR J←0 STEP 1 UNTIL 63 DO BEGIN OUT(CHAN2,"-");
00930 IF J≠63 THEN IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
00940
00950 END;
00960
00970 PROCEDURE BOTTOM;
00980 BEGIN
00990 OUT(CHAN2,TB&"+");
01000 FOR J←0 STEP 1 UNTIL 63 DO BEGIN OUT(CHAN2,"-");
01010 IF J≠63 THEN IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
01020 OUT(CHAN2,"+"&CRLF0);
01030 END;
01040
00010 FILEI←"SEG1.T01";UPCNT←3;OPT1←"N";FILEC←0;
00020 CHAN4←4;CHAN6←6; CHAN2←2;CHAN1←1;
00030 OUTSTR("This program produces cluster diagrams of data on T0 files"&crlf);
00040 BIN←16;
00050 HEADIN;
00060 OUTSTR("Four phones or features may be specified"&CRLF);
00070 FOR L←0 STEP 1 UNTIL 3 DO BEGIN "PHIN"
00080 WHILE TRUE DO
00090 IF (GATENA[L]←STRIN("Type Ph or Feature )= "))="" then
00100 BEGIN GFLAG[L]←0; GATENA[L]←"Empty"; DONE END ELSE BEGIN
00110 GFLAG[L]←1; I←CVASC(GATENA[L]);
00120 FOR J←0 STEP 1 UNTIL 63 DO IF PHLIST[J]=I THEN DONE;
00130 IF J≤63 THEN BEGIN GVAL[L]←PHLIST[J]; DONE END ELSE BEGIN
00140 FOR J←0 STEP 1 UNTIL 35 DO IF FLIST[J]=I THEN DONE;
00150 IF J≤35 THEN BEGIN GVAL[L]←(1 LSH (35-J)); GFLAG[L]←2; DONE END
00160 ELSE OUTSTR("Gate not identified"&CRLF); END;
00170 END; END "PHIN";
00180
00190 OUTSTR("Two input parameters are to be specified"&crlf);
00200 FOR L←0 STEP 1 UNTIL 1 DO BEGIN
00210 WHILE TRUE DO BEGIN
00220 IN[L]←STRIN("Type input name = "); J←CVASC(IN[L]);
00230 FOR P←0 STEP 1 UNTIL INSIZ-1 DO IF J=INNAM[P] THEN DONE;
00240 IF P<INSIZ THEN BEGIN IX[L]←P;DONE END
00250 ELSE OUTSTR("Not found"&CRLF); END; END; M1←IX[0]; N1←IX[1];
00260
00270 CLOSE(CHAN2); OPEN(CHAN2,"DSK",0,0,'10,0,0,0);
00280 SPONAM←GATENA[0]&".HIS";
00290 ENTER(CHAN2,SPONAM,0);
00300 OUT(CHAN2,"The following files were used "&CRLF);
00310 setformat(1,0);
00320 ⊂ **** MAIN ROUTINE STARTS HERE****;
00330 WHILE TRUE DO BEGIN
00340 STRT: CLOSE(CHAN6);
00350 IF OPT1≠"Y" THEN
00360 IF (TFILEI←STRIN("Data file FFT/LPC ("&FILEI&")="))≠"" THEN
00370 FILEI←TFILEI ELSE OPT1←"Y";
00380 IF FILEI="E" THEN DONE;
00390 IF OPT1="Y" THEN BEGIN FILEC←FILEC+1; SETFORMAT(1,0);
00400 IF FILEC>7 THEN DONE;
00410 FILEI←"SEG"&CVS(FILEC)&".T0X"; END;
00420
00430 CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00440 LOOKIN(CHAN4,FILEI); EOF←SEGC←SEGCNT←0;
00450 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
00460 IF LFILE[21]=0 THEN DONE; ⊂ No more hints;
00470 HINDEX←21; HCOUNT←HINCNT←0;
00480 SEGTOT←(LFILE[0])*3%128; RATE←LFILE[2];
00490 OUTSTR(" "&FILEI);
00500 OUT(CHAN2," "&FILEI);
00510
00520
00530
00540 WHILE EOF=0 DO BEGIN "DATAIN"
00550 ARRYIN(CHAN4,DATBUF[0],BUFSIZ); ⊂ Get data;
00560 BPT←POINT(6,DATBUF[0],-1);
00570
00580 FOR Q←1 STEP 1 UNTIL BUFSIZ%4 DO BEGIN
00590 SEGC←SEGC+1;
00600 IF SEGC>SEGTOT THEN DONE;
00610
00620 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
00630 I←HEADER;
00640 FOR L←0 STEP 1 UNTIL 3 DO BEGIN "XL"
00650 WHILE TRUE DO BEGIN
00660 IF GFLAG[L]=0 THEN DONE ELSE IF GFLAG[L]=1 THEN BEGIN
00670 IF I≠GVAL[L] THEN DONE; END ELSE BEGIN
00680 FOR J←0 STEP 1 UNTIL 63 DO IF I=PHLIST[J] THEN DONE;
00690 IF J>63 THEN DONE ELSE
00700 IF (HLIST[J] LAND GVAL[L])=0 THEN DONE; END;
00710 M←INDAT[M1]; N←INDAT[N1];
00720 COUNT[M,N]←COUNT[M,N]+BIT[L];
00730 SUMM[M,L]←SUMM[M,L]+1; SUMN[N,L]←SUMN[N,L]+1;
00740 DONE END;
00750 MTOT[L]←NTOT[L]←0;
00760 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
00770 MTOT[L]←MTOT[L]+SUMM[J,L]; NTOT[L]←NTOT[L]+SUMN[J,L]; END;
00780
00790 END "XL";
00800
00810 END;
00820 IF SEGC>SEGTOT THEN DONE;
00830 END "DATAIN"; CLOSE(CHAN4); END; close(chan4);
00840 OUT(CHAN2,CRLF&LF);
00850
00860 FOR L←0 STEP 1 UNTIL 3 DO IF GFLAG[L]≠0 THEN BEGIN "PXL"
00870 OUT(CHAN2,CRLF&"Cluster plot for feature "&GATENA[L]&" with inputs "&
00880 IN[0]&" and "&IN[1]&"."&TB&DATIME&CRLF);
00890 OUT(CHAN2," Number of entries= "&CVS(MTOT[L])&LF&CRLF);
00900 IF MTOT[L]≠NTOT[L] THEN OUTSTR("ERROR IN COUNTS"&CRLF);
00910 TOP;
00920 TOT←TOTD←0;
00930 OUT(CHAN2,"+ Sums Decile"&CRLF);
00940 FOR M←0 STEP 1 UNTIL 63 DO BEGIN
00950 SETFORMAT(2,0); OUT(CHAN2,CVS(M)&TB&"|"); SETFORMAT(1,0);
00960 FOR N←0 STEP 1 UNTIL 63 DO BEGIN
00970 Q←(COUNT[M,N] LSH ((L*9)-27)) LAND '777;
00980
00990 IF Q=0 THEN OUT(CHAN2," ") ELSE
01000 IF Q>9 THEN OUT(CHAN2,"&") ELSE
01010 OUT(CHAN2,CVS(Q));
01020 IF N≠63 THEN IF (N MOD 8)=7 THEN OUT(CHAN2," "); END;
01030 SETFORMAT(4,0); OUT(CHAN2,"|"&CVS(SUMM[M,L]));
01040 TOT←TOT+SUMM[M,L]*10;
01050 IF TOT≥MTOT[L] THEN BEGIN WHILE TOT≥MTOT[L] DO BEGIN
01060 TOT←TOT-MTOT[L]; TOTD←TOTD+1; END;
01070 IF TOTD<10 THEN OUT(CHAN2," _"&CVS(TOTD)); END;
01080 OUT(CHAN2,CRLF0);
01090 IF M≠63 THEN IF (M MOD 8)=7 THEN OUT(CHAN2,CRLF0);
01100
01110 OUT(CHAN2," ");
01120 END;
01130 BOTTOM;
01140 SETFORMAT(3,0); OUT(CHAN2,"Sums →"&TB&"|");
01150 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
01160 OUT(CHAN2,CVS(SUMN[J,L])[1 TO 1]);
01170 IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
01180 OUT(CHAN2,CRLF0&TB&"|");
01190 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
01200 OUT(CHAN2,CVS(SUMN[J,L])[2 TO 2]);
01210 IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
01220 OUT(CHAN2,CRLF0&TB&"|");
01230 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
01240 OUT(CHAN2,CVS(SUMN[J,L])[3 TO 3]);
01250 IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
01260 SETFORMAT(1,0);
01270 TOT←TOTD←0; OUT(CHAN2,CRLF&LF&"Decile"&TB&" ");
01280 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
01290 TOT←TOT+SUMN[J,L]*10;
01300 IF TOT≥NTOT[L] THEN BEGIN WHILE TOT≥NTOT[L] DO BEGIN
01310 TOT←TOT-NTOT[L]; TOTD←TOTD+1; END;
01320 IF TOTD<10 THEN OUT(CHAN2,CVS(TOTD)); END ELSE OUT(CHAN2," ");
01330 IF (J MOD 8) =7 THEN OUT(CHAN2," "); END;
01340 OUT(CHAN2,FF); END "PXL";
01350
01360
01370 OUT(CHAN2,CRLF&
01380 "Confusion plot (overlap of features) with inputs "&
01390 IN[0]&" and "&IN[1]&"."&TB&DATIME&crlf&LF&TB&
01400 "Key: 1="&GATENA[0]&" and "&GATENA[1]&CRLF&TB&" "&
01410 "2="&GATENA[0]&" and "&GATENA[2]&CRLF&TB&" "&
01420 "3="&GATENA[0]&" and "&GATENA[3]&CRLF&TB&" "&
01430 "4="&GATENA[1]&" and "&GATENA[2]&CRLF&TB&" "&
01440 "5="&GATENA[1]&" and "&GATENA[3]&CRLF&TB&" "&
01450 "6="&GATENA[2]&" and "&GATENA[3]&CRLF&TB&" ");
01460 OUT(CHAN2,
01470 "A="&GATENA[0]&", "&GATENA[1]&" and "&GATENA[2]&CRLF&TB&" "&
01480 "B="&GATENA[0]&", "&GATENA[1]&" and "&GATENA[3]&CRLF&TB&" "&
01490 "C="&GATENA[0]&", "&GATENA[2]&" and "&GATENA[3]&CRLF&TB&" "&
01500 "D="&GATENA[1]&", "&GATENA[2]&" and "&GATENA[3]&CRLF&TB&" "&
01510 "&= All four of the features"&CRLF&LF);
01520
01530 TOP;
01540 OUT(CHAN2,"+"&CRLF);
01550 FOR M←0 STEP 1 UNTIL 63 DO BEGIN
01560 SETFORMAT(2,0); OUT(CHAN2,CVS(M)&TB&"|"); SETFORMAT(1,0);
01570 FOR N←0 STEP 1 UNTIL 63 DO BEGIN
01580 Q←COUNT[M,N]; P←0;
01590
01600 IF (Q LAND '000777777777)=0 THEN P←1 ELSE
01610 IF (Q LAND '777000777777)=0 THEN P←1 ELSE
01620 IF (Q LAND '777777000777)=0 THEN P←1 ELSE
01630 IF (Q LAND '777777777000)=0 THEN P←1;
01640 IF P=1 THEN OUT(CHAN2," ") ELSE
01650 FOR L←0 STEP 1 UNTIL 10 DO
01660 IF (Q LAND MASK[L])=0 THEN BEGIN
01670 OUT(CHAN2,CVXSTR(SYMBOL[L])[6 TO 6]); DONE END;
01680 IF N≠63 THEN IF (N MOD 8)=7 THEN OUT(CHAN2," "); END;
01690 OUT(CHAN2,"|"&CRLF0);
01700 IF M≠63 THEN IF (M MOD 8)=7 THEN OUT(CHAN2,CRLF0);
01710 END;
01720 BOTTOM;
01730 OUT(CHAN2,FF);
01740
01750
01760 OUT(CHAN2,CRLF&"Composite plot showing feature dominance with inputs "
01770 &IN[0]&" and "&IN[1]&"."&TB&DATIME&CRLF&LF
01780 &TB&"Key: 1="&GATENA[0]&CRLF
01790 &TB&" 2="&GATENA[1]&CRLF
01800 &TB&" 3="&GATENA[2]&CRLF
01810 &TB&" 4="&GATENA[3]&CRLF&LF);
01820 TOP;
01830 OUT(CHAN2,"+"&CRLF);
01840 FOR M←0 STEP 1 UNTIL 63 DO BEGIN
01850 SETFORMAT(2,0); OUT(CHAN2,CVS(M)&TB&"|"); SETFORMAT(1,0);
01860 FOR N←0 STEP 1 UNTIL 63 DO BEGIN
01870 J←COUNT[M,N];
01880 M1←(J LSH -27) LAND '777;
01890 M2←(J LSH -18) LAND '777;
01900 M3←(J LSH -9) LAND '777;
01910 M4←J LAND '777;
01920 Q←0;
01930 IF M1=M2=M3=M4 THEN OUT(CHAN2," ") ELSE BEGIN
01940 IF M1>M2 THEN IF M1>M3 THEN BEGIN
01950 IF M1>M4 THEN Q←1 ELSE Q←4; END ELSE BEGIN
01960 IF M3>M4 THEN Q←3 ELSE Q←4; END ELSE
01970 IF M2≥M1 THEN IF M2>M3 THEN BEGIN
01980 IF M2>M4 THEN Q←2 ELSE Q←4 END ELSE BEGIN
01990 IF M3>M4 THEN Q←3 ELSE Q←4; END;
02000 IF Q=1 THEN BEGIN OUT(CHAN2,"1"); M1←0; END ELSE
02010 IF Q=2 THEN BEGIN OUT(CHAN2,"2"); M2←0; END ELSE
02020 IF Q=3 THEN BEGIN OUT(CHAN2,"3"); M3←0; END ELSE
02030 IF Q=4 THEN BEGIN OUT(CHAN2,"4"); M4←0; END;
02040 COUNT[M,N]←(M1 LSH 27)+(M2 LSH 18)+(M3 LSH 9)+M4;
02050 ⊂ This removes the dominant data from the array
02060 so that submerged data can be shown;
02070 END;
02080 IF N≠63 THEN IF (N MOD 8)=7 THEN OUT(CHAN2," "); END;
02090 OUT(CHAN2,"|"&CRLF0);
02100 IF M≠63 THEN IF (M MOD 8)=7 THEN OUT(CHAN2,CRLF0);
02110 END;
02120 BOTTOM;
02130 OUT(CHAN2,FF);
02140
02150
02160 FOR L←0 STEP 1 UNTIL 3 DO IF GFLAG[L]≠0 THEN BEGIN "PSXL"
02170 OUT(CHAN2,CRLF&"Submerged data for feature "&GATENA[L]&" with inputs "&
02180 IN[0]&" and "&IN[1]&"."&TB&DATIME&CRLF&LF);
02190 out(chan2,tb&"Features considered are "&GATENA[0]&", "&GATENA[1]&
02200 ", "&GATENA[2]&" and "&GATENA[3]&"."&CRLF&LF);
02210 TOP;
02220 OUT(CHAN2,CRLF);
02230 FOR M←0 STEP 1 UNTIL 63 DO BEGIN
02240 SETFORMAT(2,0); OUT(CHAN2,CVS(M)&TB&"|"); SETFORMAT(1,0);
02250 FOR N←0 STEP 1 UNTIL 63 DO BEGIN
02260 Q←(COUNT[M,N] LSH ((L*9)-27)) LAND '777;
02270
02280 IF Q=0 THEN OUT(CHAN2," ") ELSE
02290 IF Q>9 THEN OUT(CHAN2,"&") ELSE
02300 OUT(CHAN2,CVS(Q));
02310 IF N≠63 THEN IF (N MOD 8)=7 THEN OUT(CHAN2," "); END;
02320 SETFORMAT(4,0); OUT(CHAN2,"|"&CRLF0);
02330 IF M≠63 THEN IF (M MOD 8)=7 THEN OUT(CHAN2,CRLF0);
02340 END;
02350 BOTTOM;
02360 OUT(CHAN2,FF); END "PSXL";
02370 CLOSE(CHAN2);
02380 SPOOL(SPONAM,GETCHAN,0);
02390
02400 END "CLUSTER";